home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / vbIRCd - F18134492001.psc / vbIRCd / Mod_DataSYS.bas < prev    next >
Encoding:
BASIC Source File  |  2001-04-05  |  10.5 KB  |  236 lines
  1. Attribute VB_Name = "Mod_DataSYS"
  2. ' vbIRCd - Software/Code is an IRCd(Internet Relay Chat Daemon) used to host IRC sessions
  3. ' Copyright (C) 2001  Nathan Martin
  4. '
  5. ' This program is free software; you can redistribute it and/or modify
  6. ' it under the terms of the GNU General Public License as published by
  7. ' the Free Software Foundation; either version 2 of the License, or
  8. ' (at your option) any later version.
  9. '
  10. ' This program is distributed in the hope that it will be useful,
  11. ' but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. ' GNU General Public License for more details.
  14. '
  15. ' You should have received a copy of the GNU General Public License
  16. ' along with this program; if not, write to the Free Software
  17. ' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18. '
  19. ' To Contact the author e-mail TRON at tron@ircd-net.org
  20. ' * Note: There is no post mail contact information due to that it can be abused...
  21. '
  22. '
  23. '
  24.  
  25.  
  26. Public Sub SYS(Text As String, Index As Integer)
  27. On Error Resume Next
  28. Dim X As Integer
  29. Dim Z As Integer
  30. Dim Y As Integer
  31. Dim Q As Integer
  32. Dim iX As Double
  33. Dim TmpText As String
  34. Dim TmpText2 As String
  35. Dim TmpLoad As String
  36. Dim TmpMsg As String
  37. Dim TmpFlag As String
  38. Dim TmpData As String
  39. Dim DFY As Boolean
  40. Dim DUI As Boolean ' Dead User Info
  41. With frmMain
  42.     
  43.     iPing(Index) = 0 ' Let's reset ping idle so we won't have to ping alive connections
  44.     sBReceived = sBReceived + Len(Text)
  45.     sTReceived = sTReceived + 1
  46. Text = Text & " "
  47.     If Left$(LCase(Text), 2 + Len(iUser(Index))) = ":" & LCase(iUser(Index)) & " " Then Text = Mid$(Text, 2 + Len(iUser(Index)))
  48.     If Left$(Text, 1) = ":" Then Exit Sub
  49. ReScan:
  50.     If Left$(Text, 1) = " " Then Text = Mid$(Text, 2): GoTo ReScan
  51.     If Left$(Text, 1) = Chr$(34) Then
  52.         Text = Mid$(Text, 2)
  53.         Text = Mid$(Text, 1, Len(Text) - 3)
  54.         Text = Text & " ": GoTo ReScan
  55.     End If
  56.     If Text = "" Then Exit Sub
  57.     
  58.     If Not Left$(Text, 5) = "PONG " Then If iFC(Index) > iFloodCMDs Then KillUser Index, sServer, "Command Flooding": Exit Sub
  59.     If Not Left$(Text, 5) = "PONG " Then If Not iFloodCMDs = 0 And iUserLevel(Index) = 0 Then iFC(Index) = iFC(Index) + 1
  60.     If Not Left$(Text, 5) = "PONG " Then If Not iFloodCMDs = 0 And iFC(Index) = iFloodCMDs Then SendData Index, ":" & sServer & " NOTICE " & iUser(Index) & " :*** WARNING: DO NOT SEND ONE MORE COMMAND FOR ONE MINUTE OR ELSE YOU WILL BE DISCONNECTED FOR FLOODING!!!" & CRLF
  61.     
  62.     'Text = Mid$(Text, 1, Len(Text) - 2)
  63.     
  64.     If Left$(UCase(Text), 5) = "PASS " Then
  65.         xPASS = xPASS + 1
  66.         xPASS2 = xPASS2 + Len(Text)
  67.         TmpText = Mid$(Text, 1, Len(Text) - 1)
  68.         TmpText = Mid$(TmpText, 6)
  69.         If sACC = 1 Then
  70.             If LCase(TmpText) = LCase(iConnPass) Then
  71.                 iAAC(Index) = True
  72.                 LogIt "Pass-Accepted -> '" & TmpText & "'"
  73.             Else
  74.                 SendData Index, ":" & sServer & " 464 AUTH :Password incorrect" & CRLF
  75.                 KillUser Index, sServer, "Password incorrect"
  76.             End If
  77.         End If
  78.         If sACC = 2 Then iTP(Index) = TmpText
  79.         Exit Sub
  80.     End If
  81.     
  82.     If sACC = 1 Then
  83.         If iAAC(Index) = False Then
  84.             KillUser Index, sServer, "Connection access password incorrect"
  85.             Exit Sub
  86.         End If
  87.     End If
  88.     
  89.     If Left$(UCase(Text), 5) = "NICK " Then
  90.         xNICK = xNICK + 1
  91.         xNICK2 = xNICK2 + Len(Text)
  92.         TmpText = Mid$(Text, 1, Len(Text) - 1)
  93.         TmpText = Mid$(TmpText, 6)
  94.         Q = InStr(1, TmpText, " ")
  95.         If Not Q = 0 Then TmpText = Mid$(TmpText, 1, Q - 1)
  96.         If Left$(TmpText, 1) = ":" Then TmpText = Mid$(TmpText, 2)
  97.         If TmpText = "" Then SendData Index, ":" & sServer & " 461 " & iUser(Index) & " NICK :Not enough parameters" & CRLF: Exit Sub
  98.         For Q = 1 To iUserMax
  99.             If LCase(iUser(Q)) = LCase(TmpText) Then
  100.                 If Not Index = Q Then
  101.                     SendData Index, ":" & sServer & " 433 " & iUser(Index) & " :Nickname already in use" & CRLF
  102.                     Exit Sub
  103.                 Else
  104.                     If TmpText = iUser(Index) Then Exit Sub
  105.                     Exit For
  106.                 End If
  107.             End If
  108.         Next Q
  109.         
  110.             If sNickValid(TmpText) = True Then
  111.                 If sNameCheck(TmpText) = True And sFONN = 1 Then
  112.                     SendData Index, ":" & sServer & " 432 " & iUser(Index) & " " & TmpText & " :Erroneus nickname -That type of nick is not allowed to be used" & CRLF
  113.                     Exit Sub
  114.                 End If
  115.                 
  116.                 If iUserLevel(Index) = 0 Then
  117.                     For X = 1 To sQline.Count
  118.                         If LCase(TmpText) Like LCase(sQline(X)) Then
  119.                             SendData Index, ":" & sServer & " 432 " & iUser(Index) & " " & TmpText & " :Erroneus nickname -Nick is reserved(Reason: " & sQlineR(X) & ")" & CRLF & _
  120.                                             ":" & sServer & " NOTICE " & iUser(Index) & " :*** ERROR: Cannot use '" & TmpText & "' nickname cause it's Q:lined(Reason: " & sQlineR(X) & ")" & CRLF
  121.                             Exit Sub
  122.                         End If
  123.                     Next X
  124.                 End If
  125.             Else
  126.                 SendData Index, ":" & sServer & " 432 " & iUser(Index) & " " & TmpText & " :Erroneus nickname" & CRLF
  127.                 Exit Sub
  128.             End If
  129.             
  130.         If iUser(Index) = "" And Not iName(Index) = "" Then
  131.             iUser(Index) = TmpText
  132.             If iHost(Index) = "" Then Exit Sub
  133.             
  134.             For X = 1 To sKline.Count
  135.                 If LCase(iName(Index) & "@" & iRHost(Index)) Like LCase(sKline(X)) Then
  136.                     DUI = False
  137.                     For Q = 1 To sEline.Count
  138.                         If iName(X) & "@" & iRHost(X) Like sEline(Q) Then
  139.                             DUI = True
  140.                             Exit For
  141.                         End If
  142.                     Next Q
  143.                     If DUI = False Then
  144.                         SendData Index, "ERROR :You are banned from this server, Reason: " & sKlineR(X) & CRLF
  145.                         KillUser Index, sServer, "(" & sKlineR(X) & "(KLINED))", , True, True
  146.                         Exit Sub
  147.                     End If
  148.                     Exit For
  149.                 End If
  150.             Next X
  151.             
  152.             For X = 1 To sAKill.Count
  153.                 If LCase(iName(Index) & "@" & iRHost(Index)) Like LCase(sAKill(X)) Then
  154.                     DUI = False
  155.                     For Q = 1 To sEline.Count
  156.                         If iName(X) & "@" & iRHost(X) Like sEline(Q) Then
  157.                             DUI = True
  158.                             Exit For
  159.                         End If
  160.                     Next Q
  161.                     If DUI = False Then
  162.                         SendData Index, "ERROR :You are banned from this network, Reason: " & sAKillR(X) & CRLF
  163.                         KillUser Index, sServer, "(" & sAKillR(X) & "(AKILLED))", , True, True
  164.                         Exit Sub
  165.                     End If
  166.                     Exit For
  167.                 End If
  168.             Next X
  169.             
  170.             For Q = 1 To iUserMax
  171.                 If iPeerFree(Q) = False Then
  172.                     X = InStr(1, iModes(Q), "c")
  173.                     If Not X = 0 Then SendData2 Q, ":" & sServer & " NOTICE " & iUser(Q) & " :*** NOTICE -- " & iUser(Index) & " (" & iName(Index) & "@" & iRHost(Index) & ") has connected to server on port " & .Win(Index).LocalPort & CRLF
  174.                 End If
  175.             Next Q
  176.             
  177.             SendData Index, _
  178.                 ":" & sServer & " 001 " & iUser(Index) & " :Welcome to the " & iNetName & " IRC Network " & iUser(Index) & "!" & iName(Index) & "@" & iRHost(Index) & CRLF & _
  179.                 ":" & sServer & " 002 " & iUser(Index) & " :Your Host is " & sServer & ", Running vbIRCd(IRCServ Clone) " & sVersion & " " & sRelease & CRLF & _
  180.                 ":" & sServer & " 003 " & iUser(Index) & " :This server was created " & sUDT & CRLF & _
  181.                 ":" & sServer & " 004 " & iUser(Index) & " :" & sServer & " vbIRCd-" & sVersion & " oOiwghskSaHANTcCfrxebWqBFI1dvtGz lvhopsmntikrRcaqOALQbSeKVfHGCuzN" & CRLF & _
  182.                 ":" & sServer & " 005 " & iUser(Index) & " :NOQUIT ISON USERS MODES=13 MAXCHANNELS=" & iChanMax & " MAXBANS=60 NICKLEN=30 TOPICLEN=307 KICKLEN=307 CHANTYPES=# PREFIX=(ohv)@%+ :are available on this server" & CRLF
  183.             SendLUSERS Index
  184.             SendMOTD Index
  185.             iSignOn(Index) = GetTime
  186.             
  187.             .lbl_UC = .lbl_UC - 1
  188.             .lbl_CU = .lbl_CU + 1
  189.             If .lbl_HU = .lbl_CU - 1 Then .lbl_HU = .lbl_CU
  190.             .lbl_CGU = .lbl_CGU + 1
  191.             If .lbl_HGU = .lbl_CGU - 1 Then .lbl_HGU = .lbl_HGU + 1
  192.             If iForceCloak = 1 Then uMode Index, iUser(Index), "+x"
  193.         Else
  194.             If uCanNICK(iUser(Index), Index) = False Then Exit Sub
  195.             TmpText2 = iUser(Index)
  196.             iUser(Index) = TmpText
  197.             SendData Index, ":" & TmpText2 & "!" & iName(Index) & "@" & iRHost(Index) & " NICK :" & iUser(Index) & CRLF
  198.             uNickChange TmpText2 & "!" & iName(Index) & "@" & iHost(Index), iChan(Index), iUser(Index)
  199.         End If
  200.         Exit Sub
  201.     End If
  202.     
  203.     If Left$(UCase(Text), 7) = "SERVER " Then
  204.         xSERVER = xSERVER + 1
  205.         xSERVER2 = xSERVER2 + Len(Text)
  206.         TmpText = Mid$(Text, 8)
  207.         If iUser(Index) = "" And iName(Index) = "" Then
  208.             SendData Index, "ERROR :IRC Serv doesn't support linking IRCDs yet..." & CRLF
  209.             UserClosed Index, "ERROR: Server " & TmpText & "(" & .Win(Index).PeerAddress & ") tried to link to this non-linkable ircd."
  210.         Else
  211.             SendData Index, ":" & sServer & " NOTICE " & iUser(Index) & " :Sorry, but your IRC software doesn't appear to support changing servers." & CRLF
  212.         End If
  213.         Exit Sub
  214.     End If
  215.     
  216.     If Left$(UCase(Text), 5) = "USER " Then
  217.         xUSER = xUSER + 1
  218.         xUSER2 = xUSER2 + Len(Text)
  219.         Text = Mid$(Text, 1, Len(Text) - 1)
  220.         TmpText = Text
  221.         TmpText = Mid$(TmpText, 6)
  222.         If xt
  223.         TmpText = Mid$(TmpText, 6)
  224.  1)
  225.         TmpT
  226.         TmpT
  227.         TmpT
  228.         TmpT
  229. If xt
  230.     eLdM   TmpText 6)
  231.  1(eLdM  A$(UCase(Tee al      If -w eLdmpT
  232.         TmpT
  233.         TmpT
  234. If xt
  235.     eLdM   TmpK :" &  eLdM   I=deLdM   I=deLdM  !t = Mid$(TmpText, 6)
  236.         I